unit d04_header;

interface
uses common;

Const 
   tloops = 100; {big MC loops}
   t_flip = 2000; {number of nodes needing update upon flip}
   ntseq  = 300000;
   ndflob = 5; {flip-monitor stuff}
   tact	  = 10;{action types}
Type
   flist  = array[0..t_flip] of integer;
Var
   beta			    : array[1..tloops] of myreal;	       
   mcs			    : array[1..tloops] of integer;	       
   natoc,natt,natch,sites   : integer;
   nwarn,save_e,funi	    : integer;
   ich,och,lay		    : array[1..nsites] of integer;
   o_ch			    : array[1..tloops,1..t_orb,0..z_ele] of myreal;
   o_al			    : array[1..tloops,1..t_orb] of myreal;
   eav,eav2,eavn,eavr,eavnn : array[1..tloops,0..tact] of real;
   nflp,ntflp		    : integer;
   nflx			    : array[-tfla..tfla] of integer;
   noflx		    : array[1..t_obj] of integer;
   ntvl			    : array[-ttvl..0] of integer;
   chvar,export_err	    : boolean;
   chpot,feps,emin,eeps	    : myreal;
   rcutn		    : myreal;
   nseq,ivi,ihi		    : integer;
   til0,til1,til2	    : integer;
   relax_man		    : boolean;
   flip_b		    : array[-tfla..tfla,-tfla..tfla] of boolean;
   zham			    : array[-tfla..tfla] of myreal;
   flip_man,flip_rec	    : boolean;
   flip_replay,flip_monr    : boolean;
   flip_debug,flip_mon	    : boolean;
   skip_reject,save_xyzs    : boolean;
   swap_man,dfe,durecalc    : boolean;
   vflip,doflip		    : array[1..ntseq] of integer;
   fene,dfene		    : array[1..ntseq] of myreal;
   recu,txfout,txti	    : text;
   sname,iname		    : array[1..tact] of mystring;
   erec1,erec2,elimo	    : myreal;
   ndfo			    : integer;
   ndfn,ndfnu,ndfne	    : array[1..ndflob] of integer;
   ndfpth		    : array[1..ndflob] of i20;
   nndfdir		    : array[1..ndflob] of i20;
   ndfdir		    : array[1..ndflob,1..20] of i10;

   mele_buf,mele_fro	    : array[1..t_ele] of integer;
   txta:text;
   
procedure mystat(kk,lab: integer;u:myreal);
procedure occupied_sites(var ia : integer);

implementation
procedure mystat(kk,lab : integer;u:myreal);
var i : integer;
begin
   if((lab<4) or (lab=6)) then begin
      for i:=1 to sites do begin
	 o_al[kk,och[i]]:=o_al[kk,och[i]]+1;
	 o_ch[kk,och[i],ich[i]]:=o_ch[kk,och[i],ich[i]]+1;
      end;
   end;
   eav[kk,0]:=eav[kk,0]+u;
   eav[kk,lab]:=eav[kk,lab]+u;
   eav2[kk,0]:=eav2[kk,0]+u*u;
   eav2[kk,lab]:=eav2[kk,lab]+u*u;
   eavn[kk,0]:=eavn[kk,0]+1.0;
   eavn[kk,lab]:=eavn[kk,lab]+1.0;
end; { mystat }
procedure occupied_sites(var ia	: integer);
var i,j,o,l : integer;
   b,reinit : boolean;
begin
   for o:=1 to t_ele do mele_oc[o]:=0;
   for o:=0 to z_ele do chcur[o]:=0;
   if (nnele=0) then reinit:=true else reinit:=false;
   ia:=0; for i:=1 to tnodes do
      for j:=1 to nan[i] do if (n_a[i,j,1]>0) then begin ia:=ia+1;
	 {writeln('mydbg ',i:1,' ',j:1,' ',n_a[i,j,1]:1);}
	 if reinit then begin
	    b:=false;
	    for o:=1 to nnele do if (ele[o]=n_a[i,j,1]) then begin
	       mele_oc[o]:=mele_oc[o]+1; b:=true;
	    end;
	    if not(b) then begin
	       nnele:=nnele+1;
	       ele[nnele]:=n_a[i,j,1];
	       mele_oc[nnele]:=1;
	    end;
	 end else begin
	    for o:=1 to nnele do if (ele[o]=n_a[i,j,1]) then
	       mele_oc[o]:=mele_oc[o]+1;
	 end;
      end;
   for i:=1 to nnele do begin
      chcur[ele[i]]:=mele_oc[i];
   end;
end; { occupied_sites }

end.
